library(tidyverse)
Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
── Attaching packages ──────────────────────────────────────────────────────────────── tidyverse 1.3.0 ──
✓ ggplot2 3.3.2     ✓ purrr   0.3.4
✓ tibble  3.0.3     ✓ dplyr   1.0.2
✓ tidyr   1.1.2     ✓ stringr 1.4.0
✓ readr   1.3.1     ✓ forcats 0.5.0
── Conflicts ─────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
x dplyr::filter() masks stats::filter()
x dplyr::lag()    masks stats::lag()
library(streamgraph)
library(plotly)

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout
data <- read.csv('https://covid.ourworldindata.org/data/owid-covid-data.csv')
yesterday <- Sys.Date() - 1
today <- Sys.Date()
data_cleaned <- data %>%
  select(iso_code, continent, location, total_cases, total_deaths, new_deaths, date) %>%
  filter(date== yesterday & location != "World")
#data_cleaned$date <- as.Date(data_cleaned$date)
data_cleaned$hover <- with(data_cleaned, paste(location, '<br>', 
                                               "Total Cases: ", total_cases, '<br>', 
                                               "Total Deaths: ", total_deaths, '<br>', 
                                               "Date: ", date))
# light grey boundaries
l <- list(color = toRGB("grey"), width = 0.5)
# specify map projection/options
g <- list(
  showframe = FALSE,
  showcoastlines = FALSE,
  projection = list(type = 'Mercator'))

fig <- plot_geo(data_cleaned) %>% 
  add_trace(
    z = ~total_deaths, color = ~total_deaths, text = ~hover, colors = 'Reds',
    text = ~location, locations = ~iso_code, marker = list(line = l)) %>% 
  colorbar(title = 'Total Deaths') %>% 
  layout(
    title = 'Covid Data by Country<br>(Hover for breakdown)<br>
            Source:<a href="https://covid.ourworldindata.org/data/owid-covid-data.csv">Our World in Data</a>',
    dragmode= FALSE,
    geo = g
  )
Ignoring 15 observations
fig

#htmlwidgets::saveWidget(fig, "fig_plot_geo.html")
sg_data <- data %>%
  filter(grepl("^(Asia|Africa|Oceania|North America|South America|Europe)$", continent)) %>%
  group_by(date, continent) 

total_deaths_by_continent <- sg_data %>%
  tally(wt= total_deaths) %>%
  streamgraph("continent", "n", "date", offset= "zero", height= 400, width= "100%") %>%
  sg_fill_brewer(palette = "RdBu") %>%
  sg_legend(show = TRUE, label = "Continent:")
total_deaths_by_continent

#htmlwidgets::saveWidget(total_deaths_by_continent, "total_deaths_by_continent.html")

daily_cases_smoothed_by_continent <- sg_data %>%
  tally(wt= new_cases_smoothed) %>%
  streamgraph("continent", "n", "date", offset= "zero", height= 400, width= "100%") %>%
  sg_fill_brewer(palette = "Greens") %>%
  sg_legend(show = TRUE, label = "Continent:")
daily_cases_smoothed_by_continent

#htmlwidgets::saveWidget(daily_cases_smoothed_by_continent, "daily_cases_smoothed_by_continent.html")

daily_deaths_smoothed_by_continent <- sg_data %>%
  tally(wt= new_deaths_smoothed) %>%
  streamgraph("continent", "n", "date", height= 400, width= "100%") %>%
  sg_fill_brewer(palette = "Greens") %>%
  sg_legend(show = TRUE, label = "Continent:")
daily_deaths_smoothed_by_continent

#htmlwidgets::saveWidget(daily_deaths_smoothed_by_continent, "daily_deaths_smoothed_by_continent.html")
state_covid_data <- read.csv('https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-states.csv') %>% 
  filter(date== yesterday)

state_codes <- read.csv("https://raw.githubusercontent.com/plotly/datasets/master/2011_us_ag_exports.csv") %>%
  select(state, code)

state_covid_data <- merge(state_codes, state_covid_data)
state_covid_data$hover <- with(state_covid_data, paste(state, '<br>',
                           'Total Cases: ', cases, '<br>',
                           'Total Deaths: ', deaths, '<br>',
                           'Date: ', date))
# give state boundaries a white border
l <- list(color = toRGB('grey'), width = 0.5)
# specify some map projection/options
g <- list(
  scope = 'usa',
  projection = list(type = 'albers usa')
)

fig1 <- plot_geo(state_covid_data, locationmode = 'USA-states') %>% 
  add_trace(
    z = ~deaths, text = ~hover, locations = ~code,
    color = ~deaths, colors = 'Reds', marker = list(line = l)
  ) %>%
colorbar(title = 'Total Deaths') %>% 
  layout(
    title = "Covid Data by State<br>(Hover for breakdown)<br>
            Source:<a href='https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-states.csv'>New York Times</a>",
    dragmode= FALSE,
    geo = g
  )
fig1

#htmlwidgets::saveWidget(fig1, "fig_plot_geo1.html")
data <- data %>%
  filter(location != "World")
x <- list(title = "Date")

y <- list(title= "Total Deaths")

tx <- highlight_key(data, ~location)

fig2 <- plot_ly(tx, color = I("Black"), height = 500) %>% 
  group_by(location) %>%
  add_lines(x = ~date, y = ~total_deaths) %>%
  layout(
    xaxis= x, 
    yaxis= y,
    title = 'Covid Data by Country<br>(Hover for breakdown)<br>
            Source:<a href="https://covid.ourworldindata.org/data/owid-covid-data.csv">Our World in Data</a>'
    )
`group_by_()` is deprecated as of dplyr 0.7.0.
Please use `group_by()` instead.
See vignette('programming') for more help
This warning is displayed once every 8 hours.
Call `lifecycle::last_warnings()` to see where this warning was generated.
fig2 <- plotly::highlight(
  fig2, 
  on = "plotly_click", 
  selectize = TRUE, 
  dynamic = TRUE, 
  persistent = TRUE,
  color = NULL
)
Adding more colors to the selection color palette.
We recommend setting `persistent` to `FALSE` (the default) because persistent selection mode can now be used by holding the shift key (while triggering the `on` event).
fig2
Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_click'). You can change this default via the `highlight()` function.
Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_click'). You can change this default via the `highlight()` function.
htmlwidgets::saveWidget(fig, "fig_plot_geo.html")
htmlwidgets::saveWidget(fig1, "fig_plot_geo1.html")
#htmlwidgets::saveWidget(fig2, "fig_plot_geo2.html")
htmlwidgets::saveWidget(total_deaths_by_continent, "total_deaths_by_continent.html")
?color
LS0tCnRpdGxlOiAiQ292aWQtMTkiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCmBgYHtyfQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShzdHJlYW1ncmFwaCkKbGlicmFyeShwbG90bHkpCmBgYAoKYGBge3J9CmRhdGEgPC0gcmVhZC5jc3YoJ2h0dHBzOi8vY292aWQub3Vyd29ybGRpbmRhdGEub3JnL2RhdGEvb3dpZC1jb3ZpZC1kYXRhLmNzdicpCnllc3RlcmRheSA8LSBTeXMuRGF0ZSgpIC0gMQp0b2RheSA8LSBTeXMuRGF0ZSgpCmRhdGFfY2xlYW5lZCA8LSBkYXRhICU+JQogIHNlbGVjdChpc29fY29kZSwgY29udGluZW50LCBsb2NhdGlvbiwgdG90YWxfY2FzZXMsIHRvdGFsX2RlYXRocywgbmV3X2RlYXRocywgZGF0ZSkgJT4lCiAgZmlsdGVyKGRhdGU9PSB5ZXN0ZXJkYXkgJiBsb2NhdGlvbiAhPSAiV29ybGQiKQojZGF0YV9jbGVhbmVkJGRhdGUgPC0gYXMuRGF0ZShkYXRhX2NsZWFuZWQkZGF0ZSkKYGBgCgpgYGB7cn0KZGF0YV9jbGVhbmVkJGhvdmVyIDwtIHdpdGgoZGF0YV9jbGVhbmVkLCBwYXN0ZShsb2NhdGlvbiwgJzxicj4nLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiVG90YWwgQ2FzZXM6ICIsIHRvdGFsX2Nhc2VzLCAnPGJyPicsIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJUb3RhbCBEZWF0aHM6ICIsIHRvdGFsX2RlYXRocywgJzxicj4nLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiRGF0ZTogIiwgZGF0ZSkpCiMgbGlnaHQgZ3JleSBib3VuZGFyaWVzCmwgPC0gbGlzdChjb2xvciA9IHRvUkdCKCJncmV5IiksIHdpZHRoID0gMC41KQojIHNwZWNpZnkgbWFwIHByb2plY3Rpb24vb3B0aW9ucwpnIDwtIGxpc3QoCiAgc2hvd2ZyYW1lID0gRkFMU0UsCiAgc2hvd2NvYXN0bGluZXMgPSBGQUxTRSwKICBwcm9qZWN0aW9uID0gbGlzdCh0eXBlID0gJ01lcmNhdG9yJykpCgpmaWcgPC0gcGxvdF9nZW8oZGF0YV9jbGVhbmVkKSAlPiUgCiAgYWRkX3RyYWNlKAogICAgeiA9IH50b3RhbF9kZWF0aHMsIGNvbG9yID0gfnRvdGFsX2RlYXRocywgdGV4dCA9IH5ob3ZlciwgY29sb3JzID0gJ1JlZHMnLAogICAgdGV4dCA9IH5sb2NhdGlvbiwgbG9jYXRpb25zID0gfmlzb19jb2RlLCBtYXJrZXIgPSBsaXN0KGxpbmUgPSBsKSkgJT4lIAogIGNvbG9yYmFyKHRpdGxlID0gJ1RvdGFsIERlYXRocycpICU+JSAKICBsYXlvdXQoCiAgICB0aXRsZSA9ICdDb3ZpZCBEYXRhIGJ5IENvdW50cnk8YnI+KEhvdmVyIGZvciBicmVha2Rvd24pPGJyPgogICAgICAgICAgICBTb3VyY2U6PGEgaHJlZj0iaHR0cHM6Ly9jb3ZpZC5vdXJ3b3JsZGluZGF0YS5vcmcvZGF0YS9vd2lkLWNvdmlkLWRhdGEuY3N2Ij5PdXIgV29ybGQgaW4gRGF0YTwvYT4nLAogICAgZHJhZ21vZGU9IEZBTFNFLAogICAgZ2VvID0gZwogICkKZmlnCiNodG1sd2lkZ2V0czo6c2F2ZVdpZGdldChmaWcsICJmaWdfcGxvdF9nZW8uaHRtbCIpCmBgYAoKCgpgYGB7cn0Kc2dfZGF0YSA8LSBkYXRhICU+JQogIGZpbHRlcihncmVwbCgiXihBc2lhfEFmcmljYXxPY2VhbmlhfE5vcnRoIEFtZXJpY2F8U291dGggQW1lcmljYXxFdXJvcGUpJCIsIGNvbnRpbmVudCkpICU+JQogIGdyb3VwX2J5KGRhdGUsIGNvbnRpbmVudCkgCgp0b3RhbF9kZWF0aHNfYnlfY29udGluZW50IDwtIHNnX2RhdGEgJT4lCiAgdGFsbHkod3Q9IHRvdGFsX2RlYXRocykgJT4lCiAgc3RyZWFtZ3JhcGgoImNvbnRpbmVudCIsICJuIiwgImRhdGUiLCBvZmZzZXQ9ICJ6ZXJvIiwgaGVpZ2h0PSA0MDAsIHdpZHRoPSAiMTAwJSIpICU+JQogIHNnX2ZpbGxfYnJld2VyKHBhbGV0dGUgPSAiUmRCdSIpICU+JQogIHNnX2xlZ2VuZChzaG93ID0gVFJVRSwgbGFiZWwgPSAiQ29udGluZW50OiIpCnRvdGFsX2RlYXRoc19ieV9jb250aW5lbnQKI2h0bWx3aWRnZXRzOjpzYXZlV2lkZ2V0KHRvdGFsX2RlYXRoc19ieV9jb250aW5lbnQsICJ0b3RhbF9kZWF0aHNfYnlfY29udGluZW50Lmh0bWwiKQoKZGFpbHlfY2FzZXNfc21vb3RoZWRfYnlfY29udGluZW50IDwtIHNnX2RhdGEgJT4lCiAgdGFsbHkod3Q9IG5ld19jYXNlc19zbW9vdGhlZCkgJT4lCiAgc3RyZWFtZ3JhcGgoImNvbnRpbmVudCIsICJuIiwgImRhdGUiLCBvZmZzZXQ9ICJ6ZXJvIiwgaGVpZ2h0PSA0MDAsIHdpZHRoPSAiMTAwJSIpICU+JQogIHNnX2ZpbGxfYnJld2VyKHBhbGV0dGUgPSAiR3JlZW5zIikgJT4lCiAgc2dfbGVnZW5kKHNob3cgPSBUUlVFLCBsYWJlbCA9ICJDb250aW5lbnQ6IikKZGFpbHlfY2FzZXNfc21vb3RoZWRfYnlfY29udGluZW50CiNodG1sd2lkZ2V0czo6c2F2ZVdpZGdldChkYWlseV9jYXNlc19zbW9vdGhlZF9ieV9jb250aW5lbnQsICJkYWlseV9jYXNlc19zbW9vdGhlZF9ieV9jb250aW5lbnQuaHRtbCIpCgpkYWlseV9kZWF0aHNfc21vb3RoZWRfYnlfY29udGluZW50IDwtIHNnX2RhdGEgJT4lCiAgdGFsbHkod3Q9IG5ld19kZWF0aHNfc21vb3RoZWQpICU+JQogIHN0cmVhbWdyYXBoKCJjb250aW5lbnQiLCAibiIsICJkYXRlIiwgaGVpZ2h0PSA0MDAsIHdpZHRoPSAiMTAwJSIpICU+JQogIHNnX2ZpbGxfYnJld2VyKHBhbGV0dGUgPSAiR3JlZW5zIikgJT4lCiAgc2dfbGVnZW5kKHNob3cgPSBUUlVFLCBsYWJlbCA9ICJDb250aW5lbnQ6IikKZGFpbHlfZGVhdGhzX3Ntb290aGVkX2J5X2NvbnRpbmVudAojaHRtbHdpZGdldHM6OnNhdmVXaWRnZXQoZGFpbHlfZGVhdGhzX3Ntb290aGVkX2J5X2NvbnRpbmVudCwgImRhaWx5X2RlYXRoc19zbW9vdGhlZF9ieV9jb250aW5lbnQuaHRtbCIpCmBgYAoKYGBge3J9CnN0YXRlX2NvdmlkX2RhdGEgPC0gcmVhZC5jc3YoJ2h0dHBzOi8vcmF3LmdpdGh1YnVzZXJjb250ZW50LmNvbS9ueXRpbWVzL2NvdmlkLTE5LWRhdGEvbWFzdGVyL3VzLXN0YXRlcy5jc3YnKSAlPiUgCiAgZmlsdGVyKGRhdGU9PSB5ZXN0ZXJkYXkpCgpzdGF0ZV9jb2RlcyA8LSByZWFkLmNzdigiaHR0cHM6Ly9yYXcuZ2l0aHVidXNlcmNvbnRlbnQuY29tL3Bsb3RseS9kYXRhc2V0cy9tYXN0ZXIvMjAxMV91c19hZ19leHBvcnRzLmNzdiIpICU+JQogIHNlbGVjdChzdGF0ZSwgY29kZSkKCnN0YXRlX2NvdmlkX2RhdGEgPC0gbWVyZ2Uoc3RhdGVfY29kZXMsIHN0YXRlX2NvdmlkX2RhdGEpCmBgYAoKYGBge3J9CnN0YXRlX2NvdmlkX2RhdGEkaG92ZXIgPC0gd2l0aChzdGF0ZV9jb3ZpZF9kYXRhLCBwYXN0ZShzdGF0ZSwgJzxicj4nLAogICAgICAgICAgICAgICAgICAgICAgICAgICAnVG90YWwgQ2FzZXM6ICcsIGNhc2VzLCAnPGJyPicsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICdUb3RhbCBEZWF0aHM6ICcsIGRlYXRocywgJzxicj4nLAogICAgICAgICAgICAgICAgICAgICAgICAgICAnRGF0ZTogJywgZGF0ZSkpCiMgZ2l2ZSBzdGF0ZSBib3VuZGFyaWVzIGEgd2hpdGUgYm9yZGVyCmwgPC0gbGlzdChjb2xvciA9IHRvUkdCKCdncmV5JyksIHdpZHRoID0gMC41KQojIHNwZWNpZnkgc29tZSBtYXAgcHJvamVjdGlvbi9vcHRpb25zCmcgPC0gbGlzdCgKICBzY29wZSA9ICd1c2EnLAogIHByb2plY3Rpb24gPSBsaXN0KHR5cGUgPSAnYWxiZXJzIHVzYScpCikKCmZpZzEgPC0gcGxvdF9nZW8oc3RhdGVfY292aWRfZGF0YSwgbG9jYXRpb25tb2RlID0gJ1VTQS1zdGF0ZXMnKSAlPiUgCiAgYWRkX3RyYWNlKAogICAgeiA9IH5kZWF0aHMsIHRleHQgPSB+aG92ZXIsIGxvY2F0aW9ucyA9IH5jb2RlLAogICAgY29sb3IgPSB+ZGVhdGhzLCBjb2xvcnMgPSAnUmVkcycsIG1hcmtlciA9IGxpc3QobGluZSA9IGwpCiAgKSAlPiUKY29sb3JiYXIodGl0bGUgPSAnVG90YWwgRGVhdGhzJykgJT4lIAogIGxheW91dCgKICAgIHRpdGxlID0gIkNvdmlkIERhdGEgYnkgU3RhdGU8YnI+KEhvdmVyIGZvciBicmVha2Rvd24pPGJyPgogICAgICAgICAgICBTb3VyY2U6PGEgaHJlZj0naHR0cHM6Ly9yYXcuZ2l0aHVidXNlcmNvbnRlbnQuY29tL255dGltZXMvY292aWQtMTktZGF0YS9tYXN0ZXIvdXMtc3RhdGVzLmNzdic+TmV3IFlvcmsgVGltZXM8L2E+IiwKICAgIGRyYWdtb2RlPSBGQUxTRSwKICAgIGdlbyA9IGcKICApCmZpZzEKI2h0bWx3aWRnZXRzOjpzYXZlV2lkZ2V0KGZpZzEsICJmaWdfcGxvdF9nZW8xLmh0bWwiKQpgYGAKCmBgYHtyfQpkYXRhIDwtIGRhdGEgJT4lCiAgZmlsdGVyKGxvY2F0aW9uICE9ICJXb3JsZCIpCnggPC0gbGlzdCh0aXRsZSA9ICJEYXRlIikKCnkgPC0gbGlzdCh0aXRsZT0gIlRvdGFsIERlYXRocyIpCgp0eCA8LSBoaWdobGlnaHRfa2V5KGRhdGEsIH5sb2NhdGlvbikKCmZpZzIgPC0gcGxvdF9seSh0eCwgY29sb3IgPSBJKCJCbGFjayIpLCBoZWlnaHQgPSA1MDApICU+JSAKICBncm91cF9ieShsb2NhdGlvbikgJT4lCiAgYWRkX2xpbmVzKHggPSB+ZGF0ZSwgeSA9IH50b3RhbF9kZWF0aHMpICU+JQogIGxheW91dCgKICAgIHhheGlzPSB4LCAKICAgIHlheGlzPSB5LAogICAgdGl0bGUgPSAnQ292aWQgRGF0YSBieSBDb3VudHJ5PGJyPihIb3ZlciBmb3IgYnJlYWtkb3duKTxicj4KICAgICAgICAgICAgU291cmNlOjxhIGhyZWY9Imh0dHBzOi8vY292aWQub3Vyd29ybGRpbmRhdGEub3JnL2RhdGEvb3dpZC1jb3ZpZC1kYXRhLmNzdiI+T3VyIFdvcmxkIGluIERhdGE8L2E+JwogICAgKQoKZmlnMiA8LSBwbG90bHk6OmhpZ2hsaWdodCgKICBmaWcyLCAKICBvbiA9ICJwbG90bHlfY2xpY2siLCAKICBzZWxlY3RpemUgPSBUUlVFLCAKICBkeW5hbWljID0gVFJVRSwgCiAgcGVyc2lzdGVudCA9IFRSVUUsCiAgY29sb3IgPSBOVUxMCikKCmZpZzIKYGBgCgoKYGBge3J9Cmh0bWx3aWRnZXRzOjpzYXZlV2lkZ2V0KGZpZywgImZpZ19wbG90X2dlby5odG1sIikKaHRtbHdpZGdldHM6OnNhdmVXaWRnZXQoZmlnMSwgImZpZ19wbG90X2dlbzEuaHRtbCIpCiNodG1sd2lkZ2V0czo6c2F2ZVdpZGdldChmaWcyLCAiZmlnX3Bsb3RfZ2VvMi5odG1sIikKaHRtbHdpZGdldHM6OnNhdmVXaWRnZXQodG90YWxfZGVhdGhzX2J5X2NvbnRpbmVudCwgInRvdGFsX2RlYXRoc19ieV9jb250aW5lbnQuaHRtbCIpCmBgYAoKCmBgYHtyfQo/Y29sb3IKYGBg